Internet Info 1993/Internet Info CD-ROM (Walnut Creek) (1993).iso/networking/terms/kermit/b/vmsfil.bli

Text File | 1991-02-19 | 55.3 KB | 2,722 lines

MODULE KERFIL (IDENT = '3.3.119',
    ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL)) =
BEGIN
!<BLF/WIDTH:90>

!++
! FACILITY:
!    KERMIT-32 Microcomputer to mainframe file transfer utility.
!
! ABSTRACT:
!    KERFIL contains all of the file processing for KERMIT-32.  This
!    module contains the routines to input/output characters to files
!    and to open and close the files.
!
! ENVIRONMENT:
!    VAX/VMS user mode.
!
! AUTHOR: Robert C. McQueen, CREATION DATE: 28-March-1983
!
!--

%SBTTL 'Table of Contents'
%SBTTL 'Revision History'

!++
!
! 1.0.000    By: Robert C. McQueen        On: 28-March-1983
!        Create this module.
! 1.0.001    By: Robert C. McQueen        On: 4-April-1983
!        Remove checks for <FF> in the input data stream.
!
! 1.0.002    By: Robert C. McQueen        On: 31-May-1983
!        Fix a bad check in wildcard processing.
!
! 1.0.003    By: Nick Bush            On: 13-June-1983
!        Add default file spec of .;0 so that wild-carded
!        file types don't cause all version of a file to
!        be transferred.
!
! 1.0.004    By: Robert C. McQueen        On: 20-July-1983
!        Strip off the parity bit on the compares for incoming ASCII
!        files.
!
! 1.2.005    By: Robert C. McQueen        On: 15-August-1983
!        Attempt to improve the GET%FILE and make it smaller.
!        Also start the implementation of the BLOCK file processing.
!
! 2.0.006    Release VAX/VMS Kermit-32 version 2.0
!
! 2.0.016    By: Nick Bush            On: 4-Dec-1983
!        Change how binary files are written to (hopefully) improve
!        the performance.  We will now use 510 records and only
!        write out the record when it is filled (instead of writing
!        one record per packet).  This should cut down on the overhead
!        substantially.
!
! 2.0.017    By: Nick Bush            On: 9-Dec-1983
!        Fix processing for VFC format files.  Also fix GET_ASCII
!        for PRN and FTN record types.  Change GET_ASCII so that
!        'normal' CR records get sent with trailing CRLF's instead
!        of <LF>record<CR>.  That was confusing too many people.
!
! 2.0.022    By: Nick Bush            On: 15-Dec-1983
!        Add Fixed record size (512 byte) format for writing files.
!        This can be used for .EXE files.  Also clean up writing
!        ASCII files so that we don't lose any characters.
!
! 2.0.024    By: Robert C. McQueen        On: 19-Dec-1983
!        Delete FILE_DUMP.
!
! 2.0.026    By: Nick Bush            On: 3-Jan-1983
!        Add options for format of file specification to be
!        sent in file header packets.  Also type out full file
!        specification being sent/received instead of just
!        the name we are telling the other end to use.
!
! 2.0.030    By: Nick Bush            On: 3-Feb-1983
!        Add the capability of receiving a file with a different
!        name than given by KERMSG.  The RECEIVE and GET commands
!        now really are different.
!
! 2.0.035    By: Nick Bush                On: 8-March-1984
!        Add LOG SESSION command to set a log file for CONNECT.
!        While we are doing so, clean up the command parsing a little
!        so that we don't have as many COPY_xxx routines.
!
! 2.0.036    By: Nick Bush                On: 15-March-1984
!        Fix PUT_FILE to correctly handle carriage returns which are
!        not followed by line feeds.  Count was being decremented
!        Instead of incremented.
!
! 2.0.040    By: Nick Bush                On: 22-March-1984
!        Fix processing of FORTRAN carriage control to handle lines
!        which do not contain the carriage control character (i.e., zero
!        length records).  Previously, this type of record was sending
!        infinite nulls.
!
! 3.0.045    Start of version 3.
!
! 3.0.046    By: Nick Bush                On: 29-March-1984
!        Fix debugging log file to correctly set/clear file open
!        flag.  Also make log files default to .LOG.
!
! 3.0.050    By: Nick Bush                On: 2-April-1984
!        Add SET SERVER_TIMER to determine period between idle naks.
!        Also allow for a routine to process file specs before
!        FILE_OPEN uses them.  This allows individual sites to
!        restrict the format of file specifications used by Kermit.
!
! 3.1.053    By: Robert C. McQueen            On: 9-July-1984
!        Fix FORTRAN carriage control processing to pass along
!        any character from the carriage control column that is
!        not really carriage control.
!
! Start version 3.2
!
! 3.2.067    By: Robert C. McQueen            On: 8-May-1985
!        Use $GETDVIW instead of $GETDVI.
!
! 3.2.070    By: David Stevens            On: 16-July-1985
!        Put "Sending: " prompt into NEXT_FILE routine, to make
!        VMS KERMIT similar to KERMIT-10.
!
! 3.2.077    By: Robert McQueen            On: 8-May-1986
!        Fix FORTRAN CC once and for all (I hope).
!
! Start of version 3.3
!
! 3.3.105    By: Robert McQueen            On: 8-July-1986
!        Do some clean up and attempt to fix LINK-W-TRUNC errors
!        from a BLISS-32 bug.
!
! 3.3.106    By: Robert McQueen            On: 8-July-1986
!        Fix problem of closing a fixed file and losing data.
!
! 3.3.111    By: Robert McQueen            On: 2-Oct-1986
!        Make Kermit-32 not eat the parity from a CR if a LF doesn't
!        follow it when writing an ASCII file.
!
! 3.3.112    JHW0001        Jonathan H. Welch,     28-Apr-1988 12:11
!        Fix the message generated in NEXT_FILE so that the
!        filenames displayed (i.e. Sending: foo.bar;1 as foo.bar)
!        are always terminated by a null (ASCIZ).
!
! 3.3.117    JHW006        Jonathan H. Welch,    12-May-1988
!        Calls to LIB$SIGNAL with multiple arguments were
!        not coded correctly.  For calls with multiple arguments
!        an argument count was added.
!        Minor changes to KERM_HANDLER to make use of the changed
!        argument passing method.
!
! 3.3.118    JHW010        Jonathan H. Welch,    23-Apr-1990 09:42
!        Added SET FILE BLOCKSIZE nnn (where nnn is the record size
!        in bytes) command for incoming BINARY and FIXED file transfers.
!        If no blocksize has been specified the old behavior (510 byte
!        records plus 2 bytes (for CR/LF) for BINARY files and 512
!        byte records for FIXED files will be used.
!        Also modified SHOW FILE to display record size when appropriate.
!
! 3.3.119    JHW015        Jonathan H. Welch,    16-Jul-1990 15:30
!        Fixed the logic in GET_ASCII which was causing an infinite
!        loop for files with print file carriage control.
!--

%SBTTL 'Forward definitions'

FORWARD ROUTINE
    LOG_PUT,                    ! Write a buffer out
    DUMP_BUFFER,                ! Worker routine for FILE_DUMP.
    GET_BUFFER,                    ! Routine to do $GET
    GET_ASCII,                    ! Get an ASCII character
    GET_BLOCK,                    ! Get a block character
    FILE_ERROR : NOVALUE;            ! Error processing routine

%SBTTL 'Require/Library files'
!
! INCLUDE FILES:
!

LIBRARY 'SYS$LIBRARY:STARLET';

REQUIRE 'KERCOM.REQ';

%SBTTL 'Macro definitions'
!
! MACROS:
!
%SBTTL 'Literal symbol definitions'
!
! EQUATED SYMBOLS:
!
!
! Various states for reading the data from the file
!

LITERAL
    F_STATE_PRE = 0,                ! Prefix state
    F_STATE_PRE1 = 1,                ! Other prefix state
    F_STATE_DATA = 2,                ! Data processing state
    F_STATE_POST = 3,                ! Postfix processing state
    F_STATE_POST1 = 4,                ! Secondary postfix processing state
    F_STATE_MIN = 0,                ! Min state number
    F_STATE_MAX = 4;                ! Max state number

!
! Buffer size for log file
!

LITERAL
    LOG_BUFF_SIZE = 256;            ! Number of bytes in log file buffer

%SBTTL 'Local storage'
!
! OWN STORAGE:
!

OWN
    SEARCH_FLAG,                ! Can/cannot do $SEARCH
    DEV_CLASS,                    ! Type of device we are reading
    EOF_FLAG,                    ! End of file reached.
    FILE_FAB : $FAB_DECL,            ! FAB for file processing
    FILE_NAM : $NAM_DECL,            ! NAM for file processing
    FILE_RAB : $RAB_DECL,            ! RAB for file processing
    FILE_XABFHC : $XABFHC_DECL,            ! XAB for file processing
    FILE_MODE,                    ! Mode of file (reading/writing)
    FILE_REC_POINTER,                ! Pointer to the record information
    FILE_REC_COUNT,                ! Count of the number of bytes
    REC_SIZE : LONG,                ! Record size
    REC_ADDRESS : LONG,                ! Record address
    FIX_SIZE : LONG,                ! Fixed control region size
    FIX_ADDRESS : LONG,            ! Address of buffer for fixed control region
    EXP_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)],
    RES_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)],
    RES_STR_D : BLOCK [8, BYTE];        ! Descriptor for the string

%SBTTL 'Global storage'
!
! Global storage:
!

GLOBAL

    file_blocksize,                ! Block size of for BINARY and FIXED files.
    file_blocksize_set,                ! 0=user has not specified a blocksize, 1=user has specified a blocksize
    FILE_TYPE,                    ! Type of file being xfered
    FILE_DESC : BLOCK [8, BYTE];        ! File name descriptor

%SBTTL 'External routines and storage'
!
! EXTERNAL REFERENCES:
!
!
! Storage in KERMSG
!

EXTERNAL
    ALT_FILE_SIZE,                ! Number of characters in FILE_NAME
    ALT_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],    ! Storage
    FILE_SIZE,                    ! Number of characters in FILE_NAME
    FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],
    TY_FIL,                ! Flag that file names are being typed
    CONNECT_FLAG,    ! Indicator of whether we have a terminal to type on
    FIL_NORMAL_FORM;                ! File specification type

!
!  Routines in KERTT
!

EXTERNAL ROUTINE
    TT_OUTPUT : NOVALUE;    ! Force buffered output

!
! System libraries
!

EXTERNAL ROUTINE
    LIB$GET_VM : ADDRESSING_MODE (GENERAL),
    LIB$FREE_VM : ADDRESSING_MODE (GENERAL),
    LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE;

%SBTTL 'File processing -- FILE_INIT - Initialization'

GLOBAL ROUTINE FILE_INIT : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will initialize some of the storage in the file processing
!    module.
!
! CALLING SEQUENCE:
!
!    FILE_INIT();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
    FILE_TYPE = FILE_ASC;
    file_blocksize = 512;
    file_blocksize_set = 0;

! Now set up the file specification descriptor
    FILE_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    FILE_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    FILE_DESC [DSC$A_POINTER] = FILE_NAME;
    FILE_DESC [DSC$W_LENGTH] = 0;
    EOF_FLAG = FALSE;
    END;                    ! End of FILE_INIT

%SBTTL 'GET_FILE'

GLOBAL ROUTINE GET_FILE (CHARACTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will return a character from the input file.
!    The character will be stored into the location specified by
!    CHARACTER.
!
! CALLING SEQUENCE:
!
!    GET_FILE (LOCATION_TO_STORE_CHAR);
!
! INPUT PARAMETERS:
!
!    LOCATION_TO_STORE_CHAR - This is the address to store the character
!        into.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    Character stored into the location specified.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    True - Character stored into the location specified.
!    False - End of file reached.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Define the various condition codes that we check for in this routine
!
    EXTERNAL LITERAL
    KER_EOF;                ! End of file

    LOCAL
    STATUS;                    ! Random status values

    IF .EOF_FLAG THEN RETURN KER_EOF;

    SELECTONE .FILE_TYPE OF
    SET

    [FILE_ASC, FILE_BIN, FILE_FIX] :
        STATUS = GET_ASCII (.CHARACTER);

    [FILE_BLK] :
        STATUS = GET_BLOCK (.CHARACTER);
    TES;

    RETURN .STATUS;
    END;                    ! End of GET_FILE
%SBTTL 'GET_ASCII - Get a character from an ASCII file'
ROUTINE GET_ASCII (CHARACTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
! CALLING SEQUENCE:
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!   KER_EOF -  End of file encountered
!   KER_ILLFILTYP - Illegal file type
!   KER_NORMAL - Normal return
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Status codes that are returned by this module
!
    EXTERNAL LITERAL
    KER_EOF,            ! End of file encountered
    KER_ILLFILTYP,            ! Illegal file type
    KER_NORMAL;            ! Normal return

    OWN
    CC_COUNT,            ! Count of the number of CC things to output
    CC_TYPE;            ! Type of carriage control being processed.

    LOCAL
    STATUS,                    ! For status values
    RAT;
%SBTTL 'GET_FTN_FILE_CHARACTER - Get a character from an Fortran carriage control file'
ROUTINE GET_FTN_FILE_CHARACTER (CHARACTER) =
!++
! FUNCTIONAL DESCRIPTION:
!
!   This routine will get a character from a FORTRAN carriage control file.
!   A FORTRAN carriage control file is one with FAB$M_FTN on in the FAB$B_RAT
!   field.
!
! FORMAL PARAMETERS:
!
!   CHARACTER - Address of where to store the character
!
! IMPLICIT INPUTS:
!
!   CC_TYPE - Carriage control type
!
! IMPLICIT OUTPUTS:
!
!   CC_TYPE - Updated if this is the first characte of the record
!
! COMPLETION_CODES:
!
!   System service or Kermit status code
!
! SIDE EFFECTS:
!
!   Next buffer can be read from the data file.
!--
    BEGIN
!
! Dispatch according to the state of the file being read.  Beginning of
! record, middle of record, end of record
!
    WHILE TRUE DO
    CASE .FILE_FAB[FAB$L_CTX] FROM F_STATE_MIN TO F_STATE_MAX OF
        SET
!
! Here at the beginning of a record.  We must read the buffer from the file
! at this point.  Once the buffer is read we must then determine what to do
! with the FORTRAN carriage control that at the beginning of the buffer.
!
        [F_STATE_PRE ]:
        BEGIN
!
! Local variables
!
        LOCAL
            STATUS;                ! Status returned by the
                            !  GET_BUFFER routine
!
! Get the buffer
!
        STATUS = GET_BUFFER ();            ! Get a buffer from the system
        IF (NOT .STATUS)            ! If this call failed
            OR (.STATUS EQL KER_EOF)        !  or we got an EOF
        THEN
            RETURN .STATUS;            ! Just return the status
!
! Here with a valid buffer full of data all set to be decoded
!
        IF .FILE_REC_COUNT LEQ 0        ! If nothing, use a space
        THEN                    !  for the carriage control
            CC_TYPE = %C' '
        ELSE
            BEGIN
            CC_TYPE = CH$RCHAR_A (FILE_REC_POINTER);
            FILE_REC_COUNT = .FILE_REC_COUNT - 1;
            END;
!
! Dispatch on the type of carriage control that we are processing
!
        SELECTONE .CC_TYPE OF
            SET
!
! All of these just output:
!   <DATA> <Carriage-control>
!
            [CHR_NUL, %C'+'] :
            BEGIN
            FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
            END;
!
! This outputs:
!   <LF><DATA><CR>
!
            [%C'$', %C' '] :
            BEGIN
            .CHARACTER = CHR_LFD;
            FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
            RETURN KER_NORMAL;
            END;
!
! This outputs:
!   <LF><LF><DATA><CR>
!
            [%C'0'] :
            BEGIN
            .CHARACTER = CHR_LFD;
            FILE_FAB [FAB$L_CTX] = F_STATE_PRE1;
            RETURN KER_NORMAL;
            END;
!
! This outputs:
!   <FORM FEED><DATA><CR>
!
            [%C'1'] :
            BEGIN
            .CHARACTER = CHR_FFD;
            FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
            RETURN KER_NORMAL;
            END;
!
! If we don't know the type of carriage control, then just return the
! character we read as data and set the carriage control to be space
! to fool the post processing of the record
!
            [OTHERWISE] :
            BEGIN
            .CHARACTER = .CC_TYPE;        ! Return the character
            CC_TYPE = %C' ';        ! Treat as space
            FILE_REC_POINTER = CH$PLUS(.FILE_REC_POINTER,-1);
            FILE_REC_COUNT = .FILE_REC_COUNT + 1;
            FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
            RETURN KER_NORMAL
            END;
            TES;

        END;
!
! Here to add the second LF for the double spacing FORTRAN carriage control
!
        [F_STATE_PRE1 ]:
        BEGIN
        .CHARACTER = CHR_LFD;
        FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
        RETURN KER_NORMAL;
        END;
!
! Here to read the data of the record
!
        [F_STATE_DATA]:
        BEGIN
!
! Here to read the data of the record and return it to the caller
! This section can only return KER_NORMAL to the caller
!
        IF .FILE_REC_COUNT LEQ 0        ! Anything left in the buffer
        THEN
            FILE_FAB [FAB$L_CTX] = F_STATE_POST    ! No, do post processing
        ELSE
            BEGIN
            .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);    ! Get a character
            FILE_REC_COUNT = .FILE_REC_COUNT - 1;   ! Decrement the count
            RETURN KER_NORMAL;            ! Give a good return
            END;
        END;
!
! Here to do post processing of the record.  At this point we are going
! to store either nothing as the post fix, a carriage return for overprinting
! or a carriage return and then a line feed in the POST1 state.
!
        [F_STATE_POST ]:
        BEGIN
        SELECTONE .CC_TYPE OF
            SET
!
! This stat is for no carriage control on the record.  This is for
! 'null' carriage control (VMS manual states: "Null carriage control
! (print buffer contents.)" and for prompt carriage control.
!
            [CHR_NUL, %C'$' ]:
            BEGIN
            FILE_FAB [FAB$L_CTX] = F_STATE_PRE
            END;
!
! This is the normal state, that causes the postfix for the data to be
! a line feed.
!
            [%C'0', %C'1', %C' ', %C'+' ]:
            BEGIN
            .CHARACTER = CHR_CRT;
            FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
            RETURN KER_NORMAL
            END;
            TES;

        END;
!
! Here if we are in a state that this routine doesn't set.  Just assume that
! something screwed up and give an illegal file type return to the caller
!
        [INRANGE, OUTRANGE]:
        RETURN KER_ILLFILTYP;

        TES
    END;
%SBTTL 'GET_ASCII - Main logic'
    RAT = .FILE_FAB [FAB$B_RAT] AND ( NOT FAB$M_BLK);

    IF .DEV_CLASS EQL DC$_MAILBOX THEN RAT = FAB$M_CR;    ! Mailbox needs CR's

    WHILE TRUE DO
    BEGIN

    SELECTONE .RAT OF
        SET

        [FAB$M_FTN ]:
        BEGIN
        RETURN GET_FTN_FILE_CHARACTER (.CHARACTER)
        END;

        [FAB$M_PRN, FAB$M_CR] :

        CASE .FILE_FAB [FAB$L_CTX] FROM F_STATE_MIN TO F_STATE_MAX OF
            SET

            [F_STATE_PRE] :
            BEGIN
            STATUS = GET_BUFFER ();

            IF NOT .STATUS OR .STATUS EQL KER_EOF THEN RETURN .STATUS;

            SELECTONE .RAT OF
                SET

                [FAB$M_CR] :
                BEGIN
                FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
                END;

                [FAB$M_PRN] :
                BEGIN

                LOCAL
                    TEMP_POINTER;

                TEMP_POINTER = CH$PTR (.FILE_RAB [RAB$L_RHB]);
                CC_COUNT = CH$RCHAR_A (TEMP_POINTER);
                CC_TYPE = CH$RCHAR_A (TEMP_POINTER);

                IF .CC_COUNT<7, 1> EQL 0
                THEN
                    BEGIN

                    IF .CC_COUNT<0, 7> NEQ 0
                    THEN
                    BEGIN
                    .CHARACTER = CHR_LFD;
                    CC_COUNT = .CC_COUNT - 1;

                    IF .CC_COUNT GTR 0
                    THEN
                        FILE_FAB [FAB$L_CTX] = F_STATE_PRE1
                    ELSE
                        FILE_FAB [FAB$L_CTX] = F_STATE_DATA;

                    RETURN KER_NORMAL;
                    END
                    ELSE
                    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;

                    END
                ELSE
                    BEGIN

                    SELECTONE .CC_COUNT<5, 2> OF
                    SET

                    [%B'00'] :
                        BEGIN
                        .CHARACTER = .CC_COUNT<0, 5>;
                        FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
                        RETURN KER_NORMAL;
                        END;

                    [%B'10'] :
                        BEGIN
                        .CHARACTER = .CC_COUNT<0, 5> + 128;
                        FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
                        RETURN KER_NORMAL;
                        END;

                    [OTHERWISE, %B'11'] :
                        RETURN KER_ILLFILTYP;
                    TES;
                    END;
                END;
                TES;

            END;

            [F_STATE_PRE1] :

            IF .RAT EQL FAB$M_PRN
            THEN
                BEGIN
                .CHARACTER = CHR_LFD;
                CC_COUNT = .CC_COUNT - 1;

                IF .CC_COUNT LEQ 0 THEN FILE_FAB [FAB$L_CTX] = F_STATE_DATA;

                RETURN KER_NORMAL;
                END
            ELSE
                RETURN KER_ILLFILTYP;

            [F_STATE_DATA] :
            BEGIN

            IF .FILE_REC_COUNT LEQ 0
            THEN
                FILE_FAB [FAB$L_CTX] = F_STATE_POST
            ELSE
                BEGIN
                .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
                FILE_REC_COUNT = .FILE_REC_COUNT - 1;
                RETURN KER_NORMAL;
                END;

            END;

            [F_STATE_POST] :
            BEGIN

            SELECTONE .RAT OF
                SET

                [FAB$M_CR] :
                BEGIN
                .CHARACTER = CHR_CRT;
                FILE_FAB [FAB$L_CTX] = F_STATE_POST1;
                        ! So we get a line feed
                RETURN KER_NORMAL;
                END;


                [FAB$M_PRN] :
                BEGIN

                IF .CC_TYPE<7, 1> EQL 0
                THEN
                    BEGIN

                    IF .CC_TYPE<0, 7> NEQ 0
                    THEN
                    BEGIN
                    .CHARACTER = CHR_LFD;
                    CC_COUNT = .CC_TYPE;
                    FILE_FAB [FAB$L_CTX] = F_STATE_POST1;
                                        RETURN KER_NORMAL;
                    END
                    ELSE
                    FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
                    END
                ELSE
                    BEGIN

                    SELECTONE .CC_TYPE<5, 2> OF
                    SET

                    [%B'00'] :
                        BEGIN
                        .CHARACTER = .CC_TYPE<0, 5>;
                        FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
                        RETURN KER_NORMAL;
                        END;

                    [%B'10'] :
                        BEGIN
                        .CHARACTER = .CC_TYPE<0, 5> + 128;
                        FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
                        RETURN KER_NORMAL;
                        END;

                    [OTHERWISE, %B'11'] :
                        RETURN KER_ILLFILTYP;
                    TES;

                    END;

                END;
                TES;        ! End SELECTONE .RAT

            END;

            [F_STATE_POST1] :

            IF .RAT EQL FAB$M_PRN
            THEN
                BEGIN
                .CHARACTER = CHR_LFD;
                CC_COUNT = .CC_COUNT - 1;

                IF .CC_COUNT LEQ -1
                THEN
                BEGIN
                .CHARACTER = CHR_CRT;
!                FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
                FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
                END;

                RETURN KER_NORMAL;
                END
            ELSE
!
! Generate line feed after CR for funny files
!

                IF (.RAT EQL FAB$M_CR)
                THEN
                BEGIN
                .CHARACTER = CHR_LFD;    ! Return a line feed
                FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
                        ! Next we get data
                RETURN KER_NORMAL;
                END
                ELSE
                RETURN KER_ILLFILTYP;

            TES;            ! End of CASE .STATE

        [OTHERWISE] :
        BEGIN

        WHILE .FILE_REC_COUNT LEQ 0 DO
            BEGIN
            STATUS = GET_BUFFER ();

            IF NOT .STATUS OR .STATUS EQL KER_EOF THEN RETURN .STATUS;

            END;

        FILE_REC_COUNT = .FILE_REC_COUNT - 1;
        .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
        RETURN KER_NORMAL;
        END;
        TES;                ! End of SELECTONE .RAT

    END;                    ! End WHILE TRUE DO loop

    RETURN KER_ILLFILTYP;            ! Shouldn't get here
    END;                    ! End of GET_ASCII
%SBTTL 'GET_BLOCK - Get a character from a BLOCKed file'
ROUTINE GET_BLOCK (CHARACTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will return the next byte from a blocked file.  This
!    routine will use the $READ RMS call to get the next byte from the
!    file.  This way all RMS header information can be passed to the
!    other file system.
!
! CALLING SEQUENCE:
!
!    STATUS = GET_BLOCK(CHARACTER);
!
! INPUT PARAMETERS:
!
!    CHARACTER - Address to store the character in.
!
! IMPLICIT INPUTS:
!
!    REC_POINTER - Pointer into the record.
!    REC_ADDRESS - Address of the record.
!    REC_COUNT - Count of the number of bytes left in the record.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!   KER_NORMAL - Got a byte
!   KER_EOF - End of file gotten.
!   KER_RMS32 - RMS error
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Status codes returned by this module
!
    EXTERNAL LITERAL
    KER_RMS32,                ! RMS error encountered
    KER_EOF,                ! End of file encountered
    KER_NORMAL;                ! Normal return

    LOCAL
    STATUS;                    ! Random status values

    WHILE .FILE_REC_COUNT LEQ 0 DO
    BEGIN
    STATUS = $READ (RAB = FILE_RAB);

    IF NOT .STATUS
    THEN

        IF .STATUS EQL RMS$_EOF
        THEN
        BEGIN
        EOF_FLAG = TRUE;
        RETURN KER_EOF;
        END
        ELSE
        BEGIN
        FILE_ERROR (.STATUS);
        EOF_FLAG = TRUE;
        RETURN KER_RMS32;
        END;

    FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
    FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ];
    END;

    FILE_REC_COUNT = .FILE_REC_COUNT - 1;
    .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
    RETURN KER_NORMAL;
    END;                    ! End of GET_BLOCK
%SBTTL 'GET_BUFFER - Routine to read a buffer.'
ROUTINE GET_BUFFER =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will read a buffer from the disk file.  It will
!    return various status depending if there was an error reading
!    the disk file or if the end of file is reached.
!
! CALLING SEQUENCE:
!
!    STATUS = GET_BUFFER ();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    FILE_REC_POINTER - Pointer into the record.
!    FILE_REC_COUNT - Count of the number of bytes in the record.
!
! COMPLETION CODES:
!
!    KER_NORMAL - Got a buffer
!    KER_EOF - End of file reached.
!    KER_RMS32 - RMS error
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! The following are the various status values returned by this routien
!
    EXTERNAL LITERAL
    KER_NORMAL,                ! Normal return
    KER_EOF,                ! End of file
    KER_RMS32;                ! RMS error encountered

    LOCAL
    STATUS;                    ! Random status values

    STATUS = $GET (RAB = FILE_RAB);

    IF NOT .STATUS
    THEN

    IF .STATUS EQL RMS$_EOF
    THEN
        BEGIN
        EOF_FLAG = TRUE;
        RETURN KER_EOF;
        END
    ELSE
        BEGIN
        FILE_ERROR (.STATUS);
        EOF_FLAG = TRUE;
        RETURN KER_RMS32;
        END;

    FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
    FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ];
    RETURN KER_NORMAL;
    END;
%SBTTL 'PUT_FILE'

GLOBAL ROUTINE PUT_FILE (CHARACTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will store a character into the record buffer
!    that we are building.  It will output the buffer to disk
!    when the end of line characters are found.
!
! CALLING SEQUENCE:
!
!    STATUS = PUT_FILE(Character);
!
! INPUT PARAMETERS:
!
!    Character - Address of the character to output in the file.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    Status - True if no problems writing the character
!         False if there were problems writing the character.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Completion codes
!
    EXTERNAL LITERAL
    KER_REC_TOO_BIG,            ! Record too big
    KER_NORMAL;                ! Normal return
!
! Local variables
!
    OWN
    SAVED_CHARACTER : UNSIGNED BYTE;    ! Character we may have to
                        !  write later on
    LOCAL
    STATUS;                    ! Random status values

    SELECTONE .FILE_TYPE OF
    SET

    [FILE_ASC] :
        BEGIN
!
! If the last character was a carriage return and this is a line feed,
! we will just dump the record.  Otherwise, if the last character was
! a carriage return, output both it and the current one.
!

        IF .FILE_FAB [FAB$L_CTX] NEQ F_STATE_DATA
        THEN
        BEGIN

        IF (.CHARACTER AND %O'177') EQL CHR_LFD
        THEN
            BEGIN
            FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
            RETURN DUMP_BUFFER ();
            END
        ELSE
            BEGIN

            IF .FILE_REC_COUNT GEQ .REC_SIZE
            THEN
            BEGIN
            LIB$SIGNAL (KER_REC_TOO_BIG);
            RETURN KER_REC_TOO_BIG;
            END;

            CH$WCHAR_A (.SAVED_CHARACTER, FILE_REC_POINTER);
                        ! Store the carriage return we deferred
            FILE_REC_COUNT = .FILE_REC_COUNT + 1;
            FILE_FAB [FAB$L_CTX] = F_STATE_DATA;    ! Back to normal data
            END;

        END;

!
! Here when last character was written to the file normally.  Check if
! this character might be the end of a record (or at least the start of
! end.
!

        IF (.CHARACTER AND %O'177') EQL CHR_CRT
        THEN
        BEGIN
        SAVED_CHARACTER = .CHARACTER;        ! Save the character for later
        FILE_FAB [FAB$L_CTX] = F_STATE_POST;    ! Remember we saw this
        RETURN KER_NORMAL;        ! And delay until next character
        END;

        IF .FILE_REC_COUNT GEQ .REC_SIZE
        THEN
        BEGIN
        LIB$SIGNAL (KER_REC_TOO_BIG);
        RETURN KER_REC_TOO_BIG;
        END;

        FILE_REC_COUNT = .FILE_REC_COUNT + 1;
        CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER);
        END;

    [FILE_BIN, FILE_FIX] :
        BEGIN

        IF .FILE_REC_COUNT GEQ .REC_SIZE
        THEN
        BEGIN
        STATUS = DUMP_BUFFER ();

        IF NOT .STATUS
        THEN
            BEGIN
            LIB$SIGNAL (.STATUS);
            RETURN .STATUS;
            END;

        END;

        FILE_REC_COUNT = .FILE_REC_COUNT + 1;
        CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER);
        END;

    [FILE_BLK] :
        BEGIN

        IF .FILE_REC_COUNT GEQ .REC_SIZE
        THEN
        BEGIN
        FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT;
        STATUS = $WRITE (RAB = FILE_RAB);
        FILE_REC_COUNT = 0;
        FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
        END;

        FILE_REC_COUNT = .FILE_REC_COUNT + 1;
        CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER);
        END;
    TES;

    RETURN KER_NORMAL;
    END;                    ! End of PUT_FILE

%SBTTL 'DUMP_BUFFER - Dump the current record to disk'
ROUTINE DUMP_BUFFER =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will dump the current record to disk.  It doesn't
!    care what type of file you are writing, unlike FILE_DUMP.
!
! CALLING SEQUENCE:
!
!    STATUS = DUMP_BUFFER();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    KER_NORMAL - Output went ok.
!    KER_RMS32 - RMS-32 error.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Completion codes returned:
!
    EXTERNAL LITERAL
    KER_NORMAL,                ! Normal return
    KER_RMS32;                ! RMS-32 error
!
! Local variables
!
    LOCAL
    STATUS;                    ! Random status values

!
! First update the record length
!
    FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT;
!
! Now output the record to the file
!
    STATUS = $PUT (RAB = FILE_RAB);
!
! Update the pointers first
!
    FILE_REC_COUNT = 0;
    FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
!
! Now determine if we failed attempting to write the record
!

    IF NOT .STATUS
    THEN
    BEGIN
    FILE_ERROR (.STATUS);
    RETURN KER_RMS32
    END;

    RETURN KER_NORMAL
    END;                    ! End of DUMP_BUFFER
%SBTTL 'OPEN_READING'
ROUTINE OPEN_READING =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will open a file for reading.  It will return either
!    true or false to the called depending on the success of the
!    operation.
!
! CALLING SEQUENCE:
!
!    status = OPEN_READING();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!   KER_NORMAL - Normal return
!   KER_RMS32 - RMS error encountered
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Completion codes returned:
!
    EXTERNAL LITERAL
    KER_NORMAL,                ! Normal return
    KER_RMS32;                ! RMS-32 error

    LOCAL
    STATUS;                    ! Random status values

!
! We now have an expanded file specification that we can use to process
! the file.
!

    IF .FILE_TYPE NEQ FILE_BLK
    THEN
    BEGIN
    $FAB_INIT (FAB = FILE_FAB, FAC = GET, FOP = NAM, RFM = STM, NAM = FILE_NAM,
        XAB = FILE_XABFHC);
    END
    ELSE
    BEGIN
    $FAB_INIT (FAB = FILE_FAB, FAC = (GET, BIO), FOP = NAM, RFM = STM,
        NAM = FILE_NAM, XAB = FILE_XABFHC);
    END;

    $XABFHC_INIT (XAB = FILE_XABFHC);
    STATUS = $OPEN (FAB = FILE_FAB);

    IF (.STATUS NEQ RMS$_NORMAL AND .STATUS NEQ RMS$_KFF)
    THEN
    BEGIN
    FILE_ERROR (.STATUS);
    RETURN KER_RMS32;
    END;

!
! Now allocate a buffer for the records
!
    REC_SIZE = (IF .FILE_TYPE EQL FILE_BLK THEN 512 ELSE .FILE_XABFHC [XAB$W_LRL]);

    IF .REC_SIZE EQL 0 THEN REC_SIZE = MAX_REC_LENGTH;

    STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS);
!
! Determine if we need a buffer for the fixed control area
!
    FIX_SIZE = .FILE_FAB [FAB$B_FSZ];

    IF .FIX_SIZE NEQ 0
    THEN
    BEGIN
    STATUS = LIB$GET_VM (FIX_SIZE, FIX_ADDRESS);
    END;

!
! Initialize the RAB for the $CONNECT RMS call
!
    $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, ROP = NLK, UBF = .REC_ADDRESS,
    USZ = .REC_SIZE);

    IF .FIX_SIZE NEQ 0 THEN FILE_RAB [RAB$L_RHB] = .FIX_ADDRESS;

                        ! Store header address
    STATUS = $CONNECT (RAB = FILE_RAB);

    IF NOT .STATUS
    THEN
    BEGIN
    FILE_ERROR (.STATUS);
    RETURN KER_RMS32;
    END;

    FILE_REC_COUNT = -1;
    FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
    RETURN KER_NORMAL;
    END;                    ! End of OPEN_READING
%SBTTL 'FILE_OPEN'

GLOBAL ROUTINE FILE_OPEN (FUNCTION) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will open a file for reading or writing depending on
!    the function that is passed this routine.  It will handle wildcards
!    on the read function.
!
! CALLING SEQUENCE:
!
!    status = FILE_OPEN(FUNCTION);
!
! INPUT PARAMETERS:
!
!    FUNCTION - Function to do.  Either FNC_READ or FNC_WRITE.
!
! IMPLICIT INPUTS:
!
!    FILE_NAME and FILE_SIZE set up with the file name and the length
!    of the name.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    FILE_NAME and FILE_SIZE set up with the file name and the length
!    of the name.
!
! COMPLETION CODES:
!
!   KER_NORMAL - File opened correctly.
!   KER_RMS32 - Problem processing the file.
!   KER_INTERNALERR - Internal Kermit-32 error.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Completion codes returned:
!
    EXTERNAL LITERAL
    KER_NORMAL,                ! Normal return
    KER_INTERNALERR,            ! Internal error
    KER_RMS32;                ! RMS-32 error

    EXTERNAL ROUTINE
    TT_TEXT : NOVALUE;    ! Output an ASCIZ string

    EXTERNAL ROUTINE
!
! This external routine is called to perform any checks on the file
! specification that the user wishes.  It must return a true value
! if the access is to be allowed, and a false value (error code) if
! access is to be denied.  The error code may be any valid system wide
! error code, any Kermit-32 error code (KER_xxx) or a user specific code,
! provided a message file defining the error code is loaded with Kermit-32.
!
! The routine is called as:
!
!    STATUS = USER_FILE_CHECK ( FILE NAME DESCRIPTOR, READ/WRITE FLAG)
!
! The file name descriptor points to the file specification supplied by
! the user.  The read/write flag is TRUE if the file is being read, and
! false if it is being written.
!
    USER_FILE_CHECK : ADDRESSING_MODE(GENERAL) WEAK;

    LOCAL
    STATUS,                    ! Random status values
    ITMLST : VECTOR [4, LONG],        ! For GETDVI call
    SIZE : WORD;                ! Size of resulting file name

!
! Assume we can do searches
!
    SEARCH_FLAG = TRUE;
    DEV_CLASS = DC$_DISK;            ! Assume disk file
!
! Now do the function dependent processing
!
    FILE_MODE = .FUNCTION;
    FILE_DESC [DSC$W_LENGTH] = .FILE_SIZE;    ! Length of file name
!
! Call user routine (if any)
!
    IF USER_FILE_CHECK NEQ 0
    THEN
    BEGIN
    STATUS = USER_FILE_CHECK (FILE_DESC, %REF (.FILE_MODE EQL FNC_READ));
    IF NOT .STATUS
    THEN
        BEGIN
        LIB$SIGNAL (.STATUS);
        RETURN .STATUS;
        END;
    END;
!
! Select the correct routine depending on if we are reading or writing.
!

    SELECTONE .FUNCTION OF
    SET

    [FNC_READ] :
        BEGIN
!
! Determine device type
!
        ITMLST [0] = DVI$_DEVCLASS^16 + 4;    ! Want device class
        ITMLST [1] = DEV_CLASS;        ! Put it there
        ITMLST [2] = ITMLST [2];        ! Put the size here
        ITMLST [3] = 0;            ! End the list
        STATUS = $GETDVIW (DEVNAM = FILE_DESC, ITMLST = ITMLST);
!
! If not a disk, can't do search
!
        IF .STATUS AND .DEV_CLASS NEQ DC$_DISK THEN SEARCH_FLAG = FALSE;

!
! Now set up the FAB with the information it needs.
!
        $FAB_INIT (FAB = FILE_FAB, FOP = NAM, FNA = FILE_NAME, FNS = .FILE_SIZE,
        NAM = FILE_NAM, DNM = '.;0');
!
! Now initialize the NAM block
!
        $NAM_INIT (NAM = FILE_NAM, RSA = RES_STR, RSS = NAM$C_MAXRSS, ESA = EXP_STR,
        ESS = NAM$C_MAXRSS);
!
! First parse the file specification.
!
        STATUS = $PARSE (FAB = FILE_FAB);

        IF NOT .STATUS
        THEN
        BEGIN
        FILE_ERROR (.STATUS);
        RETURN KER_RMS32;
        END;

        IF .SEARCH_FLAG
        THEN
        BEGIN
        STATUS = $SEARCH (FAB = FILE_FAB);

        IF NOT .STATUS
        THEN
            BEGIN
            FILE_ERROR (.STATUS);
            RETURN KER_RMS32;
            END;

        END;

!
! We now have an expanded file specification that we can use to process
! the file.
!
        STATUS = OPEN_READING ();        ! Open the file

        IF NOT .STATUS THEN RETURN .STATUS;    ! If we couldn't, pass error back

!
! Tell user what name we ended up with for storing the file
!

        IF ( NOT .CONNECT_FLAG) AND .TY_FIL
        THEN
        BEGIN

        IF .FILE_NAM [NAM$B_RSS] GTR 0
        THEN
            BEGIN
            CH$WCHAR (CHR_NUL,
            CH$PTR (.FILE_NAM [NAM$L_RSA],
                .FILE_NAM [NAM$B_RSL]));
            TT_TEXT (.FILE_NAM [NAM$L_RSA]);
            END
        ELSE
            BEGIN
            CH$WCHAR (CHR_NUL,
            CH$PTR (.FILE_NAM [NAM$L_ESA],
                .FILE_NAM [NAM$B_ESL]));
            TT_TEXT (.FILE_NAM [NAM$L_ESA]);
            END;

        TT_TEXT (UPLIT (%ASCIZ' as '));
        END;

        END;                ! End of [FNC_READ]

    [FNC_WRITE] :
        BEGIN

        SELECTONE .FILE_TYPE OF
        SET

        [FILE_ASC] :
            BEGIN
            $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME,
            FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM,
            ORG = SEQ, RFM = VAR, RAT = CR);
            END;

        [FILE_BIN] :
            BEGIN
            $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME,
            FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM,
            ORG = SEQ, RFM = VAR);
            END;

        [FILE_FIX] :
            BEGIN
            $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME,
            FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM,
            ORG = SEQ, RFM = FIX, MRS = (IF .file_blocksize_set
                                                       THEN .file_blocksize
                                                       ELSE 512));
            END;

        [FILE_BLK] :
            BEGIN
            $FAB_INIT (FAB = FILE_FAB, FAC = (PUT, BIO), FNA = FILE_NAME,
            FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM);
            END;
        TES;

!
! If we had an alternate file name from the receive command, use it
! instead of what KERMSG has told us.
!

        IF .ALT_FILE_SIZE GTR 0
        THEN
        BEGIN
        LOCAL
            ALT_FILE_DESC : BLOCK [8, BYTE];

        ALT_FILE_DESC = .FILE_DESC;
        ALT_FILE_DESC [DSC$W_LENGTH] = .ALT_FILE_SIZE;
        ALT_FILE_DESC [DSC$A_POINTER] = ALT_FILE_NAME;
        IF USER_FILE_CHECK NEQ 0
        THEN
            BEGIN
            STATUS = USER_FILE_CHECK (ALT_FILE_DESC, %REF (.FILE_MODE EQL FNC_READ));
            IF NOT .STATUS
            THEN
            BEGIN
            LIB$SIGNAL (.STATUS);
            RETURN .STATUS;
            END;
            END;
        FILE_FAB [FAB$L_FNA] = ALT_FILE_NAME;
        FILE_FAB [FAB$B_FNS] = .ALT_FILE_SIZE;
        END;

        $NAM_INIT (NAM = FILE_NAM, ESA = EXP_STR, ESS = NAM$C_MAXRSS, RSA = RES_STR,
        RSS = NAM$C_MAXRSS);
!
! Now allocate a buffer for the records
!
! Determine correct buffer size

        SELECTONE .FILE_TYPE OF
        SET

        [FILE_ASC] :
            REC_SIZE = MAX_REC_LENGTH;

        [FILE_BIN] :
            REC_SIZE = (IF .file_blocksize_set THEN .file_blocksize
                                                       ELSE 510);

        [FILE_BLK] :
            REC_SIZE = 512;

                [FILE_FIX] :
                    REC_SIZE =  (IF .file_blocksize_set THEN .file_blocksize
                                                        ELSE 512);

        TES;

        STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS);
!
! Now create the file
!
        STATUS = $CREATE (FAB = FILE_FAB);

        IF NOT .STATUS
        THEN
        BEGIN
        FILE_ERROR (.STATUS);
        RETURN KER_RMS32;
        END;

        $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, RBF = .REC_ADDRESS,
        ROP = <NLK, WAT>);
        STATUS = $CONNECT (RAB = FILE_RAB);

        IF NOT .STATUS
        THEN
        BEGIN
        FILE_ERROR (.STATUS);
        RETURN KER_RMS32;
        END;

!
! Set the initial state into the FAB field.  This is used to remember
! whether we need to ignore the line feed which follows a carriage return.
!
        FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
        FILE_REC_COUNT = 0;
        FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
!
! Tell user what name we ended up with for storing the file
!

        IF ( NOT .CONNECT_FLAG) AND .TY_FIL
        THEN
        BEGIN
        TT_TEXT (UPLIT (%ASCIZ' as '));

        IF .FILE_NAM [NAM$B_RSL] GTR 0
        THEN
            BEGIN
            CH$WCHAR (CHR_NUL,
            CH$PTR (.FILE_NAM [NAM$L_RSA],
                .FILE_NAM [NAM$B_RSL]));
            TT_TEXT (.FILE_NAM [NAM$L_RSA]);
            END
        ELSE
            BEGIN
            CH$WCHAR (CHR_NUL,
            CH$PTR (.FILE_NAM [NAM$L_ESA],
                .FILE_NAM [NAM$B_ESL]));
            TT_TEXT (.FILE_NAM [NAM$L_ESA]);
            END;

        TT_OUTPUT ();
        END;

        END;

    [OTHERWISE] :
        RETURN KER_INTERNALERR;
    TES;

!
! Copy the file name based on the type of file name we are to use.
! The possibilities are:
!        Normal - Just copy name and type
!        Full - Copy entire name string (either resultant or expanded)
!        Untranslated - Copy string from name on (includes version, etc.)

    IF .DEV_CLASS EQL DC$_MAILBOX
    THEN
    BEGIN
    SIZE = 0;
    FILE_NAME = 0;
    END
    ELSE

    SELECTONE .FIL_NORMAL_FORM OF
        SET

        [FNM_FULL] :
        BEGIN

        IF .FILE_NAM [NAM$B_RSL] GTR 0
        THEN
            BEGIN
            CH$COPY (.FILE_NAM [NAM$B_RSL], CH$PTR (.FILE_NAM [NAM$L_RSA]),
            CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME));
            SIZE = .FILE_NAM [NAM$B_RSL];
            END
        ELSE
            BEGIN
            CH$COPY (.FILE_NAM [NAM$B_ESL], CH$PTR (.FILE_NAM [NAM$L_ESA]),
            CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME));
            SIZE = .FILE_NAM [NAM$B_ESL];
            END

        END;

        [FNM_NORMAL, FNM_UNTRAN] :
        BEGIN
        CH$COPY (.FILE_NAM [NAM$B_NAME], CH$PTR (.FILE_NAM [NAM$L_NAME]),
            .FILE_NAM [NAM$B_TYPE], CH$PTR (.FILE_NAM [NAM$L_TYPE]), CHR_NUL,
            MAX_FILE_NAME, CH$PTR (FILE_NAME));
        SIZE = .FILE_NAM [NAM$B_NAME] + .FILE_NAM [NAM$B_TYPE];
        END;
        TES;

    IF .SIZE GTR MAX_FILE_NAME THEN FILE_SIZE = MAX_FILE_NAME ELSE FILE_SIZE = .SIZE;

    RETURN KER_NORMAL;
    END;                    ! End of FILE_OPEN

%SBTTL 'FILE_CLOSE'

GLOBAL ROUTINE FILE_CLOSE (ABORT_FLAG) =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will close a file that was opened by FILE_OPEN.
!    It assumes any data associated with the file is stored in this
!    module, since this routine is called by KERMSG.
!
! CALLING SEQUENCE:
!
!    FILE_CLOSE();
!
! INPUT PARAMETERS:
!
!    ABORT_FLAG - True if file should not be saved.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Completion codes returned:
!
    EXTERNAL LITERAL
    KER_NORMAL,                ! Normal return
    KER_RMS32;                ! RMS-32 error

    LOCAL
    STATUS;                    ! Random status values

!
! If there might be something left to write

!

    IF .FILE_MODE EQL FNC_WRITE AND (.FILE_REC_COUNT GTR 0 OR .FILE_FAB [FAB$L_CTX] NEQ
    F_STATE_DATA)
    THEN
    BEGIN

    SELECTONE .FILE_TYPE OF
        SET

        [FILE_FIX] :
        BEGIN

        INCR I FROM .FILE_REC_COUNT TO .REC_SIZE - 1 DO
            CH$WCHAR_A (CHR_NUL, FILE_REC_POINTER);
        FILE_REC_COUNT = .REC_SIZE;            ! Store the byte count
        STATUS = DUMP_BUFFER ();
        END;

        [FILE_ASC, FILE_BIN] :
        STATUS = DUMP_BUFFER ();

        [FILE_BLK] :
        BEGIN
        FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT;
        STATUS = $WRITE (RAB = FILE_RAB);

        IF NOT .STATUS
        THEN
            BEGIN
            FILE_ERROR (.STATUS);
            STATUS = KER_RMS32;
            END
        ELSE
            STATUS = KER_NORMAL;

        END;
        TES;

    IF NOT .STATUS THEN RETURN .STATUS;

    END;

!
! If reading from a mailbox, read until EOF to allow the process on the other
! end to terminal gracefully.
!

    IF .FILE_MODE EQL FNC_READ AND .DEV_CLASS EQL DC$_MAILBOX AND NOT .EOF_FLAG
    THEN

    DO
        STATUS = GET_BUFFER ()
    UNTIL ( NOT .STATUS) OR .EOF_FLAG;

    STATUS = LIB$FREE_VM (REC_SIZE, REC_ADDRESS);

    IF .FIX_SIZE NEQ 0 THEN STATUS = LIB$FREE_VM (FIX_SIZE, FIX_ADDRESS);

    IF .ABORT_FLAG AND .FILE_MODE EQL FNC_WRITE
    THEN
    FILE_FAB [FAB$V_DLT] = TRUE
    ELSE
    FILE_FAB [FAB$V_DLT] = FALSE;

    STATUS = $CLOSE (FAB = FILE_FAB);
    EOF_FLAG = FALSE;

    IF NOT .STATUS
    THEN
    BEGIN
    FILE_ERROR (.STATUS);
    RETURN KER_RMS32;
    END
    ELSE
    RETURN KER_NORMAL;

    END;                    ! End of FILE_CLOSE

%SBTTL 'NEXT_FILE'

GLOBAL ROUTINE NEXT_FILE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will cause the next file to be opened.  It will
!    call the RMS-32 routine $SEARCH and $OPEN for the file.
!
! CALLING SEQUENCE:
!
!    STATUS = NEXT_FILE;
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    FAB/NAM blocks set up from previous processing.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    FAB/NAM blocks set up for the next file.
!
! COMPLETION CODES:
!
!    TRUE - There is a next file.
!    KER_RMS32 - No next file.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Completion codes returned:
!
    EXTERNAL LITERAL
    KER_NORMAL,                ! Normal return
    KER_NOMORFILES,                ! No more files to read
    KER_RMS32;                ! RMS-32 error

    EXTERNAL ROUTINE
    TT_TEXT : NOVALUE;            ! Output an ASCIZ string

    LOCAL
    SIZE : WORD,                ! Size of the $FAO string
    STATUS;                    ! Random status values

!
! If we can't do a search, just return no more files
!

    IF NOT .SEARCH_FLAG THEN RETURN KER_NOMORFILES;

!
! Now search for the next file that we want to process.
!
    STATUS = $SEARCH (FAB = FILE_FAB);

    IF .STATUS EQL RMS$_NMF THEN RETURN KER_NOMORFILES;

    IF NOT .STATUS
    THEN
    BEGIN
    FILE_ERROR (.STATUS);
    RETURN KER_RMS32;
    END;

!
! Now we have the new file name.  All that we have to do is open the file
! for reading now.
!
    STATUS = OPEN_READING ();

    IF NOT .STATUS THEN RETURN .STATUS;

!
! Copy the file name based on the type of file name we are to use.
! The possibilities are:
!        Normal - Just copy name and type
!        Full - Copy entire name string (either resultant or expanded)
!        Untranslated - Copy string from name on (includes version, etc.)

    SELECTONE .FIL_NORMAL_FORM OF
    SET

    [FNM_FULL] :
        BEGIN

        IF .FILE_NAM [NAM$B_RSL] GTR 0
        THEN
        BEGIN
        CH$COPY (.FILE_NAM [NAM$B_RSL], CH$PTR (.FILE_NAM [NAM$L_RSA]), CHR_NUL,
            MAX_FILE_NAME, CH$PTR (FILE_NAME));
        SIZE = .FILE_NAM [NAM$B_RSL];
        END
        ELSE
        BEGIN
        CH$COPY (.FILE_NAM [NAM$B_ESL], CH$PTR (.FILE_NAM [NAM$L_ESA]), CHR_NUL,
            MAX_FILE_NAME, CH$PTR (FILE_NAME));
        SIZE = .FILE_NAM [NAM$B_ESL];
        END

        END;

    [FNM_NORMAL, FNM_UNTRAN] :
        BEGIN
        CH$COPY (.FILE_NAM [NAM$B_NAME], CH$PTR (.FILE_NAM [NAM$L_NAME]),
        .FILE_NAM [NAM$B_TYPE], CH$PTR (.FILE_NAM [NAM$L_TYPE]), CHR_NUL,
        MAX_FILE_NAME, CH$PTR (FILE_NAME));
        SIZE = .FILE_NAM [NAM$B_NAME] + .FILE_NAM [NAM$B_TYPE];
        END;
    TES;

    IF .SIZE GTR MAX_FILE_NAME THEN FILE_SIZE = MAX_FILE_NAME ELSE FILE_SIZE = .SIZE;

!
! Put prompt for NEXT_FILE sending in here
!
    IF ( NOT .CONNECT_FLAG) AND .TY_FIL
    THEN
        BEGIN
        TT_TEXT (UPLIT (%ASCIZ 'Sending: '));
        .FILE_NAM [NAM$L_RSA] + .FILE_NAM [NAM$B_RSL] = 0;
        TT_TEXT (.FILE_NAM [NAM$L_RSA]);
        TT_TEXT (UPLIT (%ASCIZ ' as '));
        TT_OUTPUT ();
        END;

    RETURN KER_NORMAL;
    END;                    ! End of NEXT_FILE

%SBTTL 'LOG_OPEN - Open a log file'

GLOBAL ROUTINE LOG_OPEN (LOG_DESC, LOG_FAB, LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! CALLING SEQUENCE:
!
!    STATUS = LOG_OPEN (LOG_DESC, LOG_FAB, LOG_RAB)
!
! INPUT PARAMETERS:
!
!    LOG_DESC - Address of descriptor for file name to be opened
!
!    LOG_FAB - Address of FAB for file
!
!    LOG_RAB - Address of RAB for file
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    LOG_FAB and LOG_RAB updated.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    Error code or true.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Completion codes returned:
!
    EXTERNAL LITERAL
    KER_NORMAL,                ! Normal return
    KER_RMS32;                ! RMS-32 error

    MAP
    LOG_DESC : REF BLOCK [8, BYTE],        ! Name descriptor
    LOG_FAB : REF $FAB_DECL,        ! FAB for file
    LOG_RAB : REF $RAB_DECL;        ! RAB for file

    LOCAL
    STATUS,                    ! Random status values
    REC_ADDRESS,                ! Address of record buffer
    REC_SIZE;                ! Size of record buffer

!
! Get memory for records
!
    REC_SIZE = LOG_BUFF_SIZE;
    STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS);

    IF NOT .STATUS
    THEN
    BEGIN
    LIB$SIGNAL (.STATUS);
    RETURN .STATUS;
    END;

!
! Initialize the FAB and RAB
!
    $FAB_INIT (FAB = .LOG_FAB, FAC = PUT, FNA = .LOG_DESC [DSC$A_POINTER],
    FNS = .LOG_DESC [DSC$W_LENGTH], FOP = (MXV, CBT, SQO, TEF), ORG = SEQ, RFM = VAR,
    RAT = CR, CTX = 0, DNA = UPLIT (%ASCII'.LOG'), DNS = 4);
    STATUS = $CREATE (FAB = .LOG_FAB);

    IF NOT .STATUS
    THEN
    BEGIN
    FILE_ERROR (.STATUS);
    LIB$FREE_VM (REC_SIZE, REC_ADDRESS);    ! Dump record buffer
    RETURN KER_RMS32;
    END;

    $RAB_INIT (RAB = .LOG_RAB, FAB = .LOG_FAB, RAC = SEQ, RBF = .REC_ADDRESS,
    RSZ = .REC_SIZE, UBF = .REC_ADDRESS, USZ = .REC_SIZE, ROP = <NLK, WAT>, CTX = 0);
    STATUS = $CONNECT (RAB = .LOG_RAB);

    IF NOT .STATUS
    THEN
    BEGIN
    FILE_ERROR (.STATUS);
    LIB$FREE_VM (REC_SIZE, REC_ADDRESS);
    $CLOSE (FAB = .LOG_FAB);
    RETURN KER_RMS32;
    END
    ELSE
    RETURN .STATUS;

    END;                    ! End of LOG_OPEN

%SBTTL 'LOG_CLOSE - Close a log file'

GLOBAL ROUTINE LOG_CLOSE (LOG_FAB, LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will close an open log file.  It will also ensure that
!the last buffer gets dumped.
!
! CALLING SEQUENCE:
!
!    STATUS = LOG_CLOSE (LOG_FAB, LOG_RAB);
!
! INPUT PARAMETERS:
!
!    LOG_FAB - Address of log file FAB
!
!    LOG_RAB - Address of log file RAB
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    Resulting status.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Completion codes returned:
!
    EXTERNAL LITERAL
    KER_RMS32;                ! RMS-32 error

    MAP
    LOG_FAB : REF $FAB_DECL,        ! FAB for log file
    LOG_RAB : REF $RAB_DECL;        ! RAB for log file

    LOCAL
    STATUS,                    ! Random status values
    REC_ADDRESS,                ! Address of record buffer
    REC_SIZE;                ! Size of record buffer

!
! First write out any outstanding data
!

    IF .LOG_RAB [RAB$L_CTX] GTR 0 THEN LOG_PUT (.LOG_RAB);    ! Dump current buffer

!
! Return the buffer
!
    REC_SIZE = LOG_BUFF_SIZE;            ! Get size of buffer
    REC_ADDRESS = .LOG_RAB [RAB$L_RBF];        ! And address
    LIB$FREE_VM (REC_SIZE, REC_ADDRESS);
!
! Now disconnect the RAB
!
    STATUS = $DISCONNECT (RAB = .LOG_RAB);

    IF NOT .STATUS
    THEN
    BEGIN
    FILE_ERROR (.STATUS);
    RETURN KER_RMS32;
    END;

!
! Now we can close the file
!
    STATUS = $CLOSE (FAB = .LOG_FAB);

    IF NOT .STATUS THEN FILE_ERROR (.STATUS);

!
! And return the result
!
    RETURN .STATUS;
    END;                    ! End of LOG_CLOSE

%SBTTL 'LOG_CHAR - Log a character to a file'

GLOBAL ROUTINE LOG_CHAR (CH, LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will write one character to an open log file.
!If the buffer becomes filled, it will dump it.  It will also
!dump the buffer if a carriage return line feed is seen.
!
! CALLING SEQUENCE:
!
!    STATUS = LOG_CHAR (.CH, LOG_RAB);
!
! INPUT PARAMETERS:
!
!    CH - The character to write to the file.
!
!    LOG_RAB - The address of the log file RAB.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    Any error returned by LOG_PUT, else TRUE.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Completion codes returned:
!
    EXTERNAL LITERAL
    KER_NORMAL;                ! Normal return

    MAP
    LOG_RAB : REF $RAB_DECL;        ! Log file RAB

    LOCAL
    STATUS;                    ! Random status value

!
! If this character is a line feed, and previous was a carriage return, then
! dump the buffer and return.
!

    IF .CH EQL CHR_LFD
    THEN
    BEGIN
!
! If we seem to have overfilled the buffer, that is because we saw a CR
! last, and had no place to put it.  Just reset the size and dump the buffer.
!

    IF .LOG_RAB [RAB$L_CTX] GTR LOG_BUFF_SIZE
    THEN
        BEGIN
        LOG_RAB [RAB$L_CTX] = LOG_BUFF_SIZE;
        RETURN LOG_PUT (.LOG_RAB);
        END;

!
! If last character in buffer is a CR, then dump buffer without the CR
!

    IF CH$RCHAR (CH$PTR (.LOG_RAB [RAB$L_RBF], .LOG_RAB [RAB$L_CTX] - 1)) EQL CHR_CRT
    THEN
        BEGIN
        LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] - 1;
        RETURN LOG_PUT (.LOG_RAB);
        END;

    END;

!
! Don't need to dump buffer because of end of line problems.  Check if
! the buffer is full.
!

    IF .LOG_RAB [RAB$L_CTX] GEQ LOG_BUFF_SIZE
    THEN
    BEGIN
!
! If character we want to store is a carriage return, then just count it and
! don't dump the buffer yet.
!

    IF .CH EQL CHR_CRT
    THEN
        BEGIN
        LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] + 1;
        RETURN KER_NORMAL;
        END;

!
! We must dump the buffer to make room for more characters
!
    STATUS = LOG_PUT (.LOG_RAB);

    IF NOT .STATUS THEN RETURN .STATUS;

    END;

!
! Here when we have some room to store the character
!
    CH$WCHAR (.CH, CH$PTR (.LOG_RAB [RAB$L_RBF], .LOG_RAB [RAB$L_CTX]));
    LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] + 1;
    RETURN KER_NORMAL;
    END;                    ! End of LOG_CHAR

%SBTTL 'LOG_LINE - Log a line to a log file'

GLOBAL ROUTINE LOG_LINE (LINE_DESC, LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will write an entire line to a log file.  And previously
! written characters will be dumped first.
!
! CALLING SEQUENCE:
!
!    STATUS = LOG_LINE (LINE_DESC, LOG_RAB);
!
! INPUT PARAMETERS:
!
!    LINE_DESC - Address of descriptor for string to be written
!
!    LOG_RAB - RAB for log file
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!   KER_NORMAL or LOG_PUT error code.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    MAP
    LINE_DESC : REF BLOCK [8, BYTE],    ! Descriptor for string
    LOG_RAB : REF $RAB_DECL;        ! RAB for file

    LOCAL
    STATUS;                    ! Random status value

!
! First check if anything is already in the buffer
!

    IF .LOG_RAB [RAB$L_CTX] GTR 0
    THEN
    BEGIN
    STATUS = LOG_PUT (.LOG_RAB);        ! Yes, write it out

    IF NOT .STATUS THEN RETURN .STATUS;    ! Pass back any errors

    END;

!
! Copy the data to the buffer
!
    CH$COPY (.LINE_DESC [DSC$W_LENGTH], CH$PTR (.LINE_DESC [DSC$A_POINTER]), CHR_NUL,
    LOG_BUFF_SIZE, CH$PTR (.LOG_RAB [RAB$L_RBF]));

    IF .LINE_DESC [DSC$W_LENGTH] GTR LOG_BUFF_SIZE
    THEN
    LOG_RAB [RAB$L_CTX] = LOG_BUFF_SIZE
    ELSE
    LOG_RAB [RAB$L_CTX] = .LINE_DESC [DSC$W_LENGTH];

!
! Now just dump the buffer
!
    RETURN LOG_PUT (.LOG_RAB);
    END;                    ! End of LOG_LINE
%SBTTL 'LOG_FAOL - Log an FAO string to the log file'

GLOBAL ROUTINE LOG_FAOL (FAOL_DESC, FAOL_PARAMS, LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will write an FAOL string to the output file.
!
! CALLING SEQUENCE:
!
!    STATUS = LOG_FAOL (FAOL_DESC, FAOL_PARAMS, LOG_RAB);
!
! INPUT PARAMETERS:
!
!    FAOL_DESC - Address of descriptor for string to be written
!
!    FAOL_PARAMS - Parameter list for FAOL call
!
!    LOG_RAB - RAB for log file
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    KER_NORMAL or $FAOL or LOG_PUT error code.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! Completion codes returned:
!
    EXTERNAL LITERAL
    KER_NORMAL;                ! Normal return

    MAP
    FAOL_DESC : REF BLOCK [8, BYTE],    ! Descriptor for string
    LOG_RAB : REF $RAB_DECL;        ! RAB for file

    LITERAL
    FAOL_BUFSIZ = 256;            ! Length of buffer

    LOCAL
    FAOL_BUFFER : VECTOR [FAOL_BUFSIZ, BYTE], ! Buffer for FAOL output
    FAOL_BUF_DESC : BLOCK [8, BYTE],    ! Descriptor for buffer
    STATUS;                    ! Random status value

!
! Initialize descriptor for buffer
!
    FAOL_BUF_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    FAOL_BUF_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    FAOL_BUF_DESC [DSC$A_POINTER] = FAOL_BUFFER;
    FAOL_BUF_DESC [DSC$W_LENGTH] = FAOL_BUFSIZ;
!
! Now do the FAOL to generate the full text
!
    STATUS = $FAOL (CTRSTR = .FAOL_DESC, OUTBUF = FAOL_BUF_DESC,
    OUTLEN = FAOL_BUF_DESC [DSC$W_LENGTH], PRMLST = .FAOL_PARAMS);
    IF NOT .STATUS THEN RETURN .STATUS;
!
! Dump the text into the file
!
    INCR I FROM 1 TO .FAOL_BUF_DESC [DSC$W_LENGTH] DO
    BEGIN
    STATUS = LOG_CHAR ( .FAOL_BUFFER [.I - 1], .LOG_RAB);
    IF NOT .STATUS THEN RETURN .STATUS;
    END;

    RETURN KER_NORMAL;

    END;                    ! End of LOG_FAOL

%SBTTL 'LOG_PUT - Write a record buffer for a log file'
ROUTINE LOG_PUT (LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will output one buffer for a log file.
!
! CALLING SEQUENCE:
!
!    STATUS = LOG_PUT (LOG_RAB);
!
! INPUT PARAMETERS:
!
!    LOG_RAB - RAB for log file.
!
! IMPLICIT INPUTS:
!
!    None.
!
! OUPTUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    Status value from RMS
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN

    MAP
    LOG_RAB : REF $RAB_DECL;        ! RAB for file

!
! Calculate record size
!
    LOG_RAB [RAB$W_RSZ] = .LOG_RAB [RAB$L_CTX];
    LOG_RAB [RAB$W_USZ] = .LOG_RAB [RAB$W_RSZ];
!
! Buffer will be empty when we finish
!
    LOG_RAB [RAB$L_CTX] = 0;
!
! And call RMS to write the buffer
!
    RETURN $PUT (RAB = .LOG_RAB);
    END;                    ! End of LOG_PUT
%SBTTL 'FILE_ERROR - Error processing for all RMS errors'
ROUTINE FILE_ERROR (STATUS) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine will process all of the RMS-32 error returns.  It will
!    get the text for the error and then it will issue a KER_ERROR for
!    the RMS failure.
!
! CALLING SEQUENCE:
!
!    FILE_ERROR();
!
! INPUT PARAMETERS:
!
!    None.
!
! IMPLICIT INPUTS:
!
!    STATUS - RMS error status.
!    FILE_NAME - File name and extension.
!    FILE_SIZE - Size of the thing in FILE_NAME.
!
! OUTPUT PARAMETERS:
!
!    None.
!
! IMPLICIT OUTPUTS:
!
!    None.
!
! COMPLETION CODES:
!
!    None.
!
! SIDE EFFECTS:
!
!    None.
!
!--

    BEGIN
!
! KERMIT completion codes
!
    EXTERNAL LITERAL
    KER_RMS32;                ! RMS-32 error

    LOCAL
    ERR_BUFFER : VECTOR [CH$ALLOCATION (MAX_MSG)],
    ERR_DESC : BLOCK [8, BYTE] PRESET    ! String descriptor to
           ([DSC$B_CLASS ] = DSC$K_CLASS_S,    !  the error buffer
        [DSC$B_DTYPE ] = DSC$K_DTYPE_T,    !  standard string
        [DSC$W_LENGTH ] = MAX_MSG,    !  descriptor
        [DSC$A_POINTER ] = ERR_BUFFER);

    $GETMSG (MSGID = .STATUS,
             MSGLEN = ERR_DESC [DSC$W_LENGTH],
             BUFADR = ERR_DESC,
             FLAGS = 1);
    LIB$SIGNAL (KER_RMS32, 2, ERR_DESC, FILE_DESC);
    END;                    ! End of FILE_ERROR
%SBTTL 'End of KERFIL'
END                        ! End of module

ELUDOM